home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / tsptp.zip / WHETCHK.PAS < prev   
Pascal/Delphi Source File  |  1993-04-09  |  10KB  |  329 lines

  1. (******************************************************************************)
  2. (*                                  WHET.PAS                                  *)
  3. (*  For details, see Computer Journal article, 'A Synthetic Benchmark',       *)
  4. (*  Jan 1976  pp43-49 Vol. 19 No. 1. Curnow & Wichman.                        *)
  5. (******************************************************************************)
  6.  
  7. PROGRAM WhetChk(Output);
  8.  
  9. (******************************************************************************)
  10. (*                                TIMING                                      *)
  11. (******************************************************************************)
  12.  
  13. (*$IFNDEF TopSpeed *)
  14.  (*%F TRUE   *** Compile for Turbo Pascal ***)
  15.   USES TPBench;
  16.  (*%E*)
  17. (*$ELSE     *** Compile for TopSpeed Pascal ***)
  18.   IMPORT TSBench *;
  19. (*$ENDIF *)
  20.  
  21. (******************************************************************************)
  22.  
  23.   CONST
  24.     T1 = 0.499975;
  25.     T2 = 0.50025;
  26.     T3 = 2.0;
  27.     Wt = 10; (* corresponds to one million Whetstone instructions *)
  28.  
  29.   TYPE
  30.     Rlarray = ARRAY[1..4] OF BmReal;
  31.  
  32.   VAR
  33.     X, Y, Z: BmReal;
  34.     Xx:
  35.       RECORD
  36.         One, Two, Three, Four: BmReal
  37.       END;
  38.  
  39.     E1: Rlarray;
  40.     I, Jj, Kk: BmInt;
  41.     N1, N2, N3, N4, N5, N6, N7, N8, N9, N10, N11: BmInt;
  42.     J, K, L: 1..4;
  43.  
  44.     Pass   : BOOLEAN;
  45.     ChkVar : BmReal;
  46.  
  47.   PROCEDURE Check(Module: BmInt; Exp: BOOLEAN);
  48.   BEGIN
  49.     Write('Module ', Module:2);
  50.  
  51.     IF NOT Exp THEN
  52.     BEGIN
  53.       Pass := FALSE;
  54.       WriteLn(' Fail!!');
  55.     END ELSE
  56.       WriteLn(' Pass.');
  57.   END;
  58.  
  59. (*** This procedure should be commented out unless verifying the output     ***
  60.  
  61.   PROCEDURE Pout(N, J, K: BmInt; X1, X2, X3, X4: BmReal);
  62.   BEGIN
  63.     WriteLn(N:0, J:0, K:0, ' ', X1:15, ' ', X2:15, ' ', X3:15, ' ', X4:15);
  64.   END;
  65.  
  66. ***)
  67.  
  68.   PROCEDURE Proc1(VAR E:Rlarray);
  69.     VAR J: BmInt;
  70.   BEGIN
  71.     J := 0;
  72.     REPEAT
  73.       E[1] := ( E[1] + E[2] + E[3] - E[4]) * T1;
  74.       E[2] := ( E[1] + E[2] - E[3] + E[4]) * T1;
  75.       E[3] := ( E[1] - E[2] + E[3] + E[4]) * T1;
  76.       E[4] := (-E[1] + E[2] + E[3] + E[4]) / T3;
  77.       J    := J + 1;
  78.     UNTIL J = 6
  79.   END;
  80.  
  81.  
  82.   PROCEDURE Proc2(X, Y: BmReal; VAR Z: BmReal);
  83.   BEGIN
  84.     X := T1 * (X + Y);
  85.     Y := T1 * (X + Y);
  86.     Z := (X + Y) / T3
  87.   END;
  88.  
  89.  
  90.   PROCEDURE Proc3;
  91.   BEGIN
  92.     E1[J] := E1[K];
  93.     E1[K] := E1[L];
  94.     E1[L] := E1[J]
  95.   END;
  96.  
  97.  
  98.   PROCEDURE Whetstone;
  99.     VAR I: BmInt;
  100.   BEGIN
  101.  
  102.   (***          Module 1 - Convergence test using real numbers.             ***)
  103.   (*** The execution of this loop was found to be statistically invalid,    ***)
  104.   (*** but is included here for completeness.                               ***)
  105.  
  106.     Xx.One    :=  1.0;
  107.     Xx.Two    := -1.0;
  108.     Xx.Three  := -1.0;
  109.     Xx.Four   := -1.0;
  110.  
  111.     FOR I := 1 TO N1 DO
  112.     BEGIN
  113.       Xx.One    := ( Xx.One + Xx.Two + Xx.Three - Xx.Four) * T1;
  114.       Xx.Two    := ( Xx.One + Xx.Two - Xx.Three + Xx.Four) * T1;
  115.       Xx.Three  := ( Xx.One - Xx.Two + Xx.Three + Xx.Four) * T1;
  116.       Xx.Four   := (-Xx.One + Xx.Two + Xx.Three + Xx.Four) * T1
  117.     END;
  118.  
  119.     ChkVar := sqrt((Xx.One * Xx.One) + (Xx.Two * Xx.Two) +
  120.                    (Xx.Three * Xx.Three) + (Xx.Four * Xx.Four));
  121.     Check (1, (((ChkVar - exp(0.35753 - ((N1) * 6.1E-5))) / ChkVar) <= 0.1));
  122.  
  123.     (* Pout(N1,N1,N1,Xx.One,Xx.Two,Xx.Three,Xx.Four); *)
  124.  
  125.     (***        Module 2 - Convergence test using array elements.           ***)
  126.     (*** Modules 2 & 3 use variations of the following transformation       ***)
  127.     (*** statements:                                                        ***)
  128.     (***                                                                    ***)
  129.     (***    x1 = ( x1 + x2 + x3 - x4) * 0.5                                 ***)
  130.     (***    x2 = ( x1 + x2 - x3 + x4) * 0.5                                 ***)
  131.     (***    x3 = ( x1 - x2 + x3 + x4) * 0.5                                 ***)
  132.     (***    x4 = (-x1 + x2 + x3 + x4) * 0.5                                 ***)
  133.     (***                                                                    ***)
  134.     (*** Theoretically this set tends to the solution                       ***)
  135.     (***                                                                    ***)
  136.     (***    x1 = x2 = x3 = x4 = 1.0                                         ***)
  137.     (***                                                                    ***)
  138.     (*** The variables T1, T2, and T3 are terms designed to limit the       ***)
  139.     (*** convergence of the set.                                            ***)
  140.  
  141.     E1[1] :=  1.0;
  142.     E1[2] := -1.0;
  143.     E1[3] := -1.0;
  144.     E1[4] := -1.0;
  145.  
  146.     FOR I := 1 TO N2 DO
  147.     BEGIN
  148.       E1[1] := ( E1[1] + E1[2] + E1[3] - E1[4]) * T1;
  149.       E1[2] := ( E1[1] + E1[2] - E1[3] + E1[4]) * T1;
  150.       E1[3] := ( E1[1] - E1[2] + E1[3] + E1[4]) * T1;
  151.       E1[4] := (-E1[1] + E1[2] + E1[3] + E1[4]) * T1
  152.     END;
  153.  
  154.     ChkVar := sqrt((E1[1] * E1[1]) + (E1[2] * E1[2]) +
  155.                    (E1[3] * E1[3]) + (E1[4] * E1[4]));
  156.     Check (2, (((ChkVar - exp(0.35753 - ((N2) * 6.1E-5))) / ChkVar) <= 0.1));
  157.  
  158.     (* Pout(N2,N3,N2,E1[1],E1[2],E1[3],E1[4]); *)
  159.  
  160.     (***        Module 3 - Convergence test using procedure calls.          ***)
  161.  
  162.     FOR I := 1 TO N3 DO
  163.       Proc1(E1);
  164.  
  165.     ChkVar := sqrt((E1[1] * E1[1]) + (E1[2] * E1[2]) +
  166.                    (E1[3] * E1[3]) + (E1[4] * E1[4]));
  167.     Check (3, (((ChkVar - exp(0.35753 - ((N3) * 6.1E-5))) / ChkVar) <= 0.1));
  168.  
  169.     (* Pout(N3,N2,N2,E1[1],E1[2],E1[3],E1[4]); *)
  170.  
  171.     (***        Module 4 - Conditional jumps.                               ***)
  172.     (*** Repeated iterations alternate the value of Jj between 0 and 1.     ***)
  173.  
  174.     Jj := 1;
  175.  
  176.     FOR I := 1 TO N4 DO
  177.     BEGIN
  178.       IF Jj = 1 THEN
  179.         Jj := 2
  180.       ELSE
  181.         Jj := 3;
  182.  
  183.       IF Jj > 2 THEN
  184.         Jj := 0
  185.       ELSE
  186.         Jj := 1;
  187.  
  188.       IF Jj < 1 THEN
  189.         Jj := 1
  190.       ELSE
  191.         Jj := 0;
  192.     END;
  193.  
  194.     Check(4, ((Jj MOD 2) <> 0));
  195.  
  196.     (* Pout(N4,Jj,Jj,Xx.One,Xx.Two,Xx.Three,Xx.Four); *)
  197.  
  198.     (***        Module 5 - Omitted.                                         ***)
  199.  
  200.     (***        Module 6 - Integer arithmetic and array addressing.         ***)
  201.     (*** The values of integers J, K, and L remain unchanged through        ***)
  202.     (*** iterations of the loop.                                            ***)
  203.  
  204.     J := 1;
  205.     K := 2;
  206.     L := 3;
  207.  
  208.     FOR I := 1 TO N6 DO
  209.     BEGIN
  210.       J       := J * (K - J) * (L - K);
  211.       K       := L * K - (L - J) * K;
  212.       L       := (L - K) * (K + J);
  213.       E1[L-1] := (J + K + L);
  214.       E1[K-1] := (J * K * L)
  215.     END;
  216.  
  217.     Check(6, ((J = 1) AND (K = 2) AND (L = 3)));
  218.  
  219.     (* Pout(N6,J,K,E1[1],E1[2],E1[3],E1[4]); *)
  220.  
  221.     (***        Module 7 - Trigonometric functions.                         ***)
  222.     (*** The following loop almost transforms X and Y into themselves and   ***)
  223.     (*** produces results that slowly vary.  (The value of T1 ensures slow  ***)
  224.     (*** convergence, as described above.)                                  ***)
  225.  
  226.     X := 0.5;
  227.     Y := 0.5;
  228.  
  229.     FOR I := 1 TO N7 DO
  230.     BEGIN
  231.       X := T1 * arctan(T3 * sin(X) * cos(X) / (cos(X + Y) + cos(X - Y) - 1.0));
  232.       Y := T1 * arctan(T3 * sin(Y) * cos(Y) / (cos(X + Y) + cos(X - Y) - 1.0))
  233.     END;
  234.  
  235.     Check(7, (((T1 - ((Wt) * 0.001)) <= X) AND
  236.              (X <= (T1 - ((Wt) * 0.0004))) AND
  237.              ((T1 - ((Wt) * 0.0015)) <= Y) AND
  238.              (Y <=  (T1 - ((Wt) * 0.0004)))));
  239.  
  240.     (* Pout(N7,J,K,X,X,Y,Y); *)
  241.  
  242.     (***        Module 8 - Procedure calls.                                 ***)
  243.     (*** Values of X, Y, and Z are arbitrary.                               ***)
  244.  
  245.     X := 1.0;
  246.     Y := 1.0;
  247.     Z := 1.0;
  248.  
  249.     FOR I := 1 TO N8 DO
  250.       Proc2(X, Y, Z);
  251.  
  252.     Check(8, ((Z - 0.9999377) <= 1.0E-6));
  253.  
  254.     (* Pout(N8,J,K,X,Y,Z,Z); *)
  255.  
  256.     (***        Module 9 - Array references and procedure calls.            ***)
  257.  
  258.     J     := 1;
  259.     K     := 2;
  260.     L     := 3;
  261.     E1[1] := 1.0;
  262.     E1[2] := 2.0;
  263.     E1[3] := 3.0;
  264.  
  265.     FOR I := 1 TO N9 DO
  266.       Proc3;
  267.  
  268.     Check(9, ((E1[1] = 3.0) AND (E1[2] = 2.0) AND (E1[3] = 3.0)));
  269.  
  270.     (* Pout(N9,J,K,E1[1],E1[2],E1[3],E1[4]); *)
  271.  
  272.     (***      Module 10 - Simple integer arithmetic.                        ***)
  273.     (*** The execution of this loop was found to be statistically invalid,  ***)
  274.     (*** but is included here for completeness.                             ***)
  275.  
  276.     Jj := 2;
  277.     Kk := 3;
  278.  
  279.     FOR I := 1 TO N10 DO
  280.     BEGIN
  281.       Jj := Jj + Kk;
  282.       Kk := Jj + Kk;
  283.       Jj := Kk - Jj;
  284.       Kk := Kk - Jj - Jj
  285.     END;
  286.  
  287.     Check(10, ((Jj = 2) AND (Kk = 3)));
  288.  
  289.     (* Pout(N10,Jj,Kk,Xx.One,Xx.Two,Xx.Three,Xx.Four); *)
  290.  
  291.     (***        Module 11: Standard functions                               ***)
  292.  
  293.     X := 0.75;
  294.     FOR I := 1 TO N11 DO
  295.       X := sqrt(exp(ln(X) / T2));
  296.  
  297.     ChkVar := 1.0 - exp(-0.0447 * (Wt) + ln(0.26));
  298.     Check(11, ((ChkVar - X) / ChkVar <= (0.0006 + (0.065 / (5 + Wt)))));
  299.  
  300.     (* Pout(N11,Jj,Kk,X,X,X,X); *)
  301.  
  302.   END;
  303.  
  304. BEGIN
  305.   WriteLn('Whetstone Benchmark: Validation Version');
  306.  
  307. (*** The variables N1-N11 are counters for Loops 2-11.  Based on earlier    ***)
  308. (*** statistical work (Wichmann, 1970), loops 5 and 10 are omitted from the ***)
  309. (*** test.  The relative weights of modules 1 & 2 have been changed to      ***)
  310. (*** preserve the total yet exercise module 1.  This is reasonable since    ***)
  311. (*** both modules should generate identical code.                           ***)
  312.  
  313.   N1  :=   2 * Wt;                              (* Set the values of the      *)
  314.   N2  :=  10 * Wt;                              (* Module weights.            *)
  315.   N3  :=  14 * Wt;
  316.   N4  := 345 * Wt;
  317.   N5  :=   0;
  318.   N6  := 210 * Wt;
  319.   N7  :=  32 * Wt;
  320.   N8  := 899 * Wt;
  321.   N9  := 616 * Wt;
  322.   N10 :=   0;
  323.   N11 :=  93 * Wt;
  324.  
  325.   (*** Validation version, no timing loops.                                 ***)
  326.   Whetstone;
  327.  
  328. END.
  329.